home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / mltsktp.zip / QUETEST.PAS < prev    next >
Pascal/Delphi Source File  |  1988-09-20  |  2KB  |  103 lines
  1. {$R-,S-,I-,D-,T-,F-,V+,B-,N-,L+ }
  2.  
  3. PROGRAM QueueTest;
  4.  
  5. {
  6.   Demonstration: QUEUE.TPU
  7.   Autor: Christian Philipps
  8.          Hülsdonker Str. 139a
  9.          4130 Moers 1
  10. }
  11.  
  12. USES Queue;
  13.  
  14. TYPE  MyRecType   = RECORD
  15.                       Num  : Byte;
  16.                       T    : String;
  17.                     END;
  18.       MyPtrType   = ^MyRecType;
  19.  
  20. VAR   MyQueue : QueueType;
  21.       MyPtr   : MyPtrType;
  22.       Work    : String;
  23.       Count   : Byte;
  24.       n       : Byte;
  25.  
  26. {$F+}
  27. FUNCTION Compare(V,D:Pointer):BOOLEAN;
  28.  
  29. VAR BPtr : ^Byte     absolute V;
  30.     MPtr : MyPtrType absolute D;
  31.  
  32. BEGIN {Compare}
  33.   Compare := (MPtr^.Num = BPtr^);
  34. END;  {Compare}
  35. {$F-}
  36.  
  37. {$F+}
  38. FUNCTION Compare1(V,D:Pointer):BOOLEAN;
  39.  
  40. VAR SPtr : ^String   absolute V;
  41.     MPtr : MyPtrType absolute D;
  42.  
  43. BEGIN {Compare1}
  44.   Compare1 := (MPtr^.T = SPtr^);
  45. END;  {Compare1}
  46. {$F-}
  47.  
  48. PROCEDURE DisplayQueue;
  49.  
  50. VAR  n : Byte;
  51.      z : MyPtrType;
  52.  
  53. BEGIN {DisplayQueue}
  54.   FOR n := 1 TO Count DO
  55.   BEGIN
  56.     z := MyPtrType(FindRec(MyQueue,@n,@Compare));
  57.     IF z <> NIL
  58.        THEN Writeln(z^.Num:3,' ',z^.T);
  59.   END;
  60. END;  {DisplayQueue}
  61.  
  62. BEGIN {Main}
  63.   Count := 0;
  64.   CreQueue(MyQueue);
  65.   REPEAT
  66.     Write('Please input Text: ');
  67.     Readln(Work);
  68.     IF Byte(Work[0]) > 0
  69.        THEN BEGIN
  70.               New(MyPtr);
  71.               Inc(Count);
  72.               WITH MyPtr^ DO
  73.               BEGIN
  74.                 T   := Work;
  75.                 Num := Count;
  76.               END;
  77.               AppendRec(MyQueue,MyPtr);
  78.             END;
  79.   UNTIL Byte(Work[0]) = 0;
  80.  
  81.   Writeln('You have input ',Count,' elements!');
  82.   Writeln('Here they are...');
  83.   DisplayQueue;
  84.   Writeln;
  85.   Writeln('Deletion of single Elements:');
  86.   REPEAT
  87.     Write('Delete element (enter text): ');
  88.     Readln(Work);
  89.     IF Byte(Work[0]) > 0
  90.        THEN BEGIN
  91.               MyPtr := MyPtrType(FindRec(MyQueue,@Work,@Compare1));
  92.               IF MyPtr = NIL
  93.                  THEN Writeln('Element not found!')
  94.                  ELSE BEGIN
  95.                         IF RemoveRec(MyQueue,MyPtr) = NIL THEN;
  96.                         Dispose(MyPtr);
  97.                         DisplayQueue;
  98.                         Writeln;
  99.                       END;
  100.             END;
  101.   UNTIL Byte(Work[0]) = 0;
  102. END.  {Main}
  103.